home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / me_cd.zip / PICTURE.MUT < prev    next >
Lisp/Scheme  |  1988-09-07  |  24KB  |  720 lines
  1. ;; "Picture mode" -- editing using quarter-plane screen model.
  2. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  3. ;; Principal author K. Shane Hartman
  4. ;; Converted to Mutt 6/88 C Durland
  5.  
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7. ;;;;;;;;;;;;;;;;;;;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9.  
  10.   ;; Eliminate whitespace at ends of lines.
  11. (defun remove-trailing-whitespace
  12. {
  13.   (arg-prefix 9)(set-mark)
  14.   (beginning-of-buffer)
  15.   (re-query-replace '\ +$' "")
  16.   (arg-prefix 9)(exchange-dot-and-mark)
  17.   (msg "Removed trailing whitespace")
  18. })
  19.  
  20.     ; move to the next tab stop in the tabs list
  21. (defun tab-to-tab-stop (int num-tabs) (array byte tabs 1)
  22. {
  23.   (int i col)
  24.  
  25.   (col (current-column))
  26.   (for (i 0) (and (< i num-tabs)(>= col (tabs i))) (+= i 1) ())
  27.   (if (< i num-tabs) { (to-col (i (tabs i))) i } col)
  28. })
  29.  
  30. (include asc.mut)
  31.  
  32. (include me.h)
  33.  
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35. ;;;;;;;;;;;;;;;; Picture Movement Commands ;;;;;;;;;;;;;;;;;;;;;;;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37.  
  38.   ;; Move to column in current line.
  39.   ;; Differs from move-to-column in that it creates or modifies whitespace
  40.   ;;   if necessary to attain exactly the specified column.
  41. (defun move-to-column-force (int column) HIDDEN
  42. {
  43.   (current-column column) (to-col column)
  44. })
  45.  
  46.   ;; Move forward n lines, creating new ones if needed
  47. (defun pforward-line (int n) HIDDEN
  48. {
  49.   (int oo)
  50.   (oo (overstrike))(overstrike 1)
  51.   (arg-prefix n)(newline)
  52.   (overstrike oo)
  53. })
  54.  
  55.   ;; Position point after last non-blank character on current line.
  56.   ;; With ARG not nil, move forward ARG - 1 lines first.
  57.   ;; If scan reaches end of buffer, stop there without error.
  58. (defun picture-end-of-line
  59. {
  60.   (if (arg-flag) (forward-line (- (arg-prefix) 1)))
  61.   (end-of-line)
  62.   (if (previous-character)
  63.   {
  64.     (while (isspace) (previous-character))
  65.     (next-character)
  66.   })
  67. })
  68.  
  69.   ;; Move cursor right, making whitespace if necessary.
  70.   ;; With argument, move that many columns.
  71. (defun picture-forward-column
  72. {
  73.   (move-to-column-force (+ (current-column) (arg-prefix)))
  74. })
  75.  
  76.   ;; Move cursor left, making whitespace if necessary.
  77.   ;; With argument, move that many columns.
  78. (defun picture-backward-column
  79. {
  80.   (move-to-column-force (- (current-column) (arg-prefix)))
  81. })
  82.  
  83.   ;; Move vertically down, making whitespace if necessary.
  84.   ;; With argument, move that many lines.
  85. (defun picture-move-down
  86. {
  87.   (int col)
  88.  
  89.   (col (current-column))
  90.   (pforward-line (arg-prefix))
  91.   (move-to-column-force col)
  92. })
  93.  
  94.   ;; Move vertically up, making whitespace if necessary.
  95.   ;; With argument, move that many lines.
  96. (defun picture-move-up
  97. {
  98.   (int col n)
  99.  
  100.   (n (arg-prefix))
  101.   (col (current-column))
  102.  
  103.   (while (>= (-= n 1) 0)
  104.     (if (not (forward-line -1))    ; at top of buffer
  105.     { (beginning-of-buffer)(open-line) })
  106.   )
  107.   (move-to-column-force col)
  108. })
  109.  
  110.   ;; Amount to move vertically after text character in Picture mode.
  111. (int picture-vertical-step)
  112.  
  113.   ;; Amount to move horizontally after text character in Picture mode.
  114. (int picture-horizontal-step)
  115.  
  116.   ;; Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
  117.   ;; The mode line is updated to reflect the current direction.
  118. (defun picture-set-motion (int vert horiz) HIDDEN
  119. {
  120.   (picture-vertical-step vert)
  121.   (picture-horizontal-step horiz)
  122. ;  (setq mode-name
  123. ;    (format "Picture:%s"
  124. ;        (car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2))))
  125. ;                 '(nw up ne left none right sw down se)))))
  126.   (msg "Picture: "
  127.     (switch (+ 1 horiz (* 3 (+ 1 vert)))
  128.       0 "NW"
  129.       1 "up"
  130.       2 "NE"
  131.       3 "left"
  132.       4 "none"
  133.       5 "right"
  134.       6 "SW"
  135.       7 "down"
  136.       8 "SE"
  137.     )
  138.   )
  139. })
  140.  
  141.   ;; Move right after self-inserting character in Picture mode.
  142. (defun picture-movement-right { (picture-set-motion 0 1) })
  143.  
  144.   ;; Move left after self-inserting character in Picture mode.
  145. (defun picture-movement-left { (picture-set-motion 0 -1) })
  146.  
  147.   ;; Move up after self-inserting character in Picture mode.
  148. (defun picture-movement-up { (picture-set-motion -1 0) })
  149.  
  150.   ;; Move down after self-inserting character in Picture mode.
  151. (defun picture-movement-down { (picture-set-motion 1 0) })
  152.  
  153.   ;; Move up and left after self-inserting character in Picture mode.
  154. (defun picture-movement-nw { (picture-set-motion -1 -1) })
  155.  
  156.   ;; Move up and right after self-inserting character in Picture mode.
  157. (defun picture-movement-ne { (picture-set-motion -1 1) })
  158.  
  159.   ;; Move down and left after self-inserting character in Picture mode.
  160. (defun picture-movement-sw { (picture-set-motion 1 -1) })
  161.  
  162.   ;; Move down and right after self-inserting character in Picture mode.
  163. (defun picture-movement-se { (picture-set-motion 1 1) })
  164.  
  165.   ;; Move in direction of picture-vertical-step and picture-horizontal-step.
  166.   ;; With ARG do it that many times.
  167.   ;; Useful for delineating rectangles in conjunction with diagonal
  168.   ;;   picture motion.
  169.   ;; Do apropos picture-movement  to see commands which control motion.
  170. (defun picture-move
  171. {
  172.   (int col)
  173.  
  174.   (col (+ (current-column) (* picture-horizontal-step (arg-prefix))))
  175.   (case
  176.     (< picture-vertical-step 0) (picture-move-up)
  177.     (> picture-vertical-step 0) (picture-move-down)
  178.   )
  179.   (move-to-column-force col)
  180. })
  181.  
  182.   ;; Move point in direction opposite of current picture motion in Picture mode.
  183.   ;; With ARG do it that many times.
  184.   ;; Useful for delineating rectangles in conjunction with diagonal
  185.   ;;   picture motion.
  186.   ;; Do apropos picture-movement  to see commands which control motion.
  187. (defun picture-move-reverse
  188. {
  189.   (*= picture-vertical-step -1)(*= picture-horizontal-step -1)
  190.   (picture-move)
  191.   (*= picture-vertical-step -1)(*= picture-horizontal-step -1)
  192. })
  193.  
  194. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  195. ;;;;;;;;;; Picture insertion and deletion ;;;;;;;;;;;;;;;;;;;;;;;;;;
  196. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  197.  
  198.   ;; Insert character in place of character previously at the cursor.
  199.   ;; The cursor then moves in the direction previously specified
  200.   ;;   with the picture-movement- commands.
  201.   ;; Do apropos  picture-movement  to see those commands.
  202. (defun picture-insert (string c)(int n) HIDDEN
  203. {
  204.   (int i)
  205.  
  206.   (i n)
  207.   (while (> i 0)
  208.   {
  209.     (-= i 1)
  210.     (move-to-column-force (+ 1 (current-column)))    ; break up any tabs
  211.     (delete-previous-character)
  212.     (insert-text c)
  213.     (previous-character)
  214.     (arg-prefix 1)(picture-move)
  215.   })
  216. })
  217.  
  218. (defun picture-self-insert
  219. {
  220.   (string key 10)
  221.  
  222.   (picture-insert (asc (key-pressed) key) (arg-prefix))
  223. })
  224.  
  225.   ;; Clear out ARG columns after point without moving.
  226. (defun picture-clear-column
  227. {
  228.   (int col)
  229.  
  230.   (set-mark)(msg "")
  231.   (col (current-column (+ (current-column) (arg-prefix))))
  232.   (erase-region)(to-col col)
  233.   (exchange-dot-and-mark)
  234. })
  235.  
  236.   ;; Clear out ARG columns before point, moving back over them.
  237. (defun picture-backward-clear-column
  238. {
  239.   (if (== 1 (current-column)) (done))    ; no op if at begining of line
  240.   (move-to-column-force (- (current-column) (arg-prefix)))
  241.   (picture-clear-column)
  242. })
  243.  
  244.   ;; Clear out rest of line; if at end of line, advance to next line.
  245.   ;; Cleared-out line text goes into the kill ring, as do
  246.   ;;   newlines that are advanced over.
  247.   ;; With argument, clear out (and save in kill ring) that many lines.
  248. (defun picture-clear-line
  249. {
  250.   (int n)
  251.  
  252.   (if (arg-flag)
  253.     {
  254.       (arg-prefix (n (arg-prefix))) (kill-line)
  255.       (arg-prefix n)(newline)
  256.     }
  257.     {
  258.       (if (looking-at '.+$')(kill-line))
  259.       (append-to-register 0 "^J")    ; tack a newline to end of killbuffer
  260.       (forward-line 1)
  261.     }
  262.   )
  263. })
  264.  
  265.   ;; Move to the beginning of the following line.
  266.   ;; With argument, moves that many lines (up, if negative argument).
  267.   ;; Always moves to the beginning of a line.
  268. (defun picture-newline
  269. {
  270.   (int n)
  271.  
  272.   (if (< (n (arg-prefix)) 0)    ; negative arg => move up
  273.     (forward-line n)
  274.